Ce document prends comme paramètre la date du jour et la date du jour - 30 C’est une version de démo des fonctionnalités du package, et une exploration du code possible avant de faire le shiny
Les données seront chargées de 2022-11-16 à 2022-12-16
#if (interactive()){
if (!exists("mainpass")) mainpass <- getPass::getPass(msg = "main password")
if (!exists("hostmysql")) {
hostmysql. <- getPass::getPass(msg = "Saisir host")
# ci dessous pour ne pas redemander au prochain tour
hostmysql <- encrypt_string(string = hostmysql., key = mainpass)
} else {
hostmysql. <- decrypt_string(string = hostmysql, key = mainpass)
}
if (!exists("pwdmysql")) {
pwdmysql. <- getPass::getPass(msg = "Saisir password")
pwdmysql <- encrypt_string(string = pwdmysql., key = mainpass)
} else {
# pass should be loaded
pwdmysql. <- decrypt_string(string = pwdmysql, key = mainpass)
}
if (!exists("umysql")) {
umysql. <- getPass::getPass(msg = "Saisir user")
umysql <- encrypt_string(string = umysql., key = mainpass)
} else {
umysql. <- decrypt_string(string = umysql, key = mainpass)
}
# attention il faut avaoir définit mainpass <- "xxxxx"
pool <- pool::dbPool(
drv = RMariaDB::MariaDB(),
dbname = "archive_IAV",
host = hostmysql.,
username = umysql.,
password = pwdmysql.,
port=3306
)
system.time(debit_barrage <-
load_debit_barrage (debut = as.POSIXct(
strptime("2018-01-01 00:00:00", format = "%Y-%m-%d %H:%M:%S")
),
fin = as.POSIXct(
strptime("2018-01-10 00:00:00", format = "%Y-%m-%d %H:%M:%S")
),
con=pool))# 37-70 s maison # 10.5 EPTB
#> Table volet1(b_barrage_volet1_hauteur:2555), chargement de 1288 lignes
#> Table volet2(b_barrage_volet2_hauteur:2556), chargement de 1288 lignes
#> Table volet3(b_barrage_volet3_hauteur:2557), chargement de 1288 lignes
#> Table volet4(b_barrage_volet4_hauteur:2558), chargement de 1288 lignes
#> Table volet5(b_barrage_volet5_hauteur:2559), chargement de 1288 lignes
#> Table vanne1(b_barrage_vanne1_hauteur:2509), chargement de 1288 lignes
#> Table vanne2(b_barrage_vanne2_hauteur:2510), chargement de 1288 lignes
#> Table vanne3(b_barrage_vanne3_hauteur:2511), chargement de 1288 lignes
#> Table vanne4(b_barrage_vanne4_hauteur:2512), chargement de 1288 lignes
#> Table vanne5(b_barrage_vanne5_hauteur:2513), chargement de 1288 lignes
#> Table debit_vilaine_estime(b_barrage_debit:2515), chargement de 1288 lignes
#> Table debit_passe(b_barrage_debit:2523), chargement de 1288 lignes
#> Table debit_moyen_cran(b_pont_de_cran_debit:1900), chargement de 1288 lignes
#> Table tot_vol_barrage(b_barrage_volume:2550), chargement de 1288 lignes
#> Table tot_vol_passe(b_barrage_volume:2551), chargement de 1288 lignes
#> Table tot_vol_siphon(b_barrage_volume:2552), chargement de 1288 lignes
#> Table tot_vol_volet(b_barrage_volume:2553), chargement de 1288 lignes
#> Table tot_vol_ecluse(b_barrage_volume:2554), chargement de 1288 lignes
#> Table niveauvilaine(b_passeapoisson_niveauvilaine:2519), chargement de 1288 lignes
#> Table niveaumer(b_passeapoisson_niveaumer:2520), chargement de 1288 lignes
#> Table niveauvilaineb(b_barrage_niveau:2507), chargement de 1288 lignes
#> Table niveaumerb(b_barrage_niveau:2508), chargement de 1288 lignes
#> Table debit_siphon_1(b_siphon_debit:1528), chargement de 1288 lignes
#> Table debit_siphon_2(b_siphon_debit:1565), chargement de 1288 lignes
#> Table debit_vanne1(b_barrage_debit:2571), chargement de 1288 lignes
#> Table debit_vanne2(b_barrage_debit:2572), chargement de 1288 lignes
#> Table debit_vanne3(b_barrage_debit:2573), chargement de 1288 lignes
#> Table debit_vanne4(b_barrage_debit:2574), chargement de 1288 lignes
#> Table debit_vanne5(b_barrage_debit:2575), chargement de 1287 lignes
#> Table debit_volet1(b_barrage_debit:2581), chargement de 1288 lignes
#> Table debit_volet2(b_barrage_debit:2582), chargement de 1288 lignes
#> Table debit_volet3(b_barrage_debit:2583), chargement de 1288 lignes
#> Table debit_volet4(b_barrage_debit:2584), chargement de 1288 lignes
#> Table debit_volet5(b_barrage_debit:2585), chargement de 1288 lignes
#> fin des calculs
#> utilisateur système écoulé
#> 0.36 0.01 3.41
#} # end if interactive
debit_barrage <-traitement_siva(debit_barrage)
#pool:poolClose(pool)
# chargement des paramètres du barrage
#load(system.file("param2012_2014.Rdata", package = "SIVA"))
Q12345 <- debit_total(param, param0 = param, debit_barrage)
Q12345$tot_vol <- debit_barrage$tot_vol # volume total au barrage d'Arzal
Q12345$volet_vanne <-
rowSums(debit_barrage[,c("tot_vol_barrage","tot_vol_volet")], na.rm=TRUE) # volume total toutes les dix minutes sur volets et vannes
mQ <-
reshape2::melt(
Q12345[, c("horodate",
"qvanne1",
"qvanne2",
"qvanne3",
"qvanne4",
"qvanne5")],
id.vars = "horodate",
value.name = "Qvanne",
variable.name = "vanne"
)
mcond <-
reshape2::melt(Q12345[, c("horodate",
"typecalc1",
"typecalc2",
"typecalc3",
"typecalc4",
"typecalc5")], value.name = "typecalc", id.vars = "horodate")
mQ$vanne <- as.character(mQ$vanne)
mQ$vanne <- gsub("qvanne", "", mQ$vanne)
mQ12345 <- cbind(mQ, "typecalc" = mcond[, 3]) # melted object
g <-ggplot2::ggplot(mQ12345, ggplot2::aes(
x = horodate,
y = Qvanne,
col = typecalc,
shape = vanne
)) + ggplot2::geom_jitter(size = 0.6)
print(g)
# Calcul du débit journalier
Qj <-
as.data.frame(
Q12345 %>%dplyr::select(
Q,
date,
volvoletcalcule,
debit_moyen_cran,
tot_vol,
volet_vanne,
tot_vol_siphon,
tot_vol_passe,
tot_vol_ecluse
) %>%
dplyr::group_by(date) %>%
dplyr::summarize(
vol_recalc =
sum(Q * 600, volvoletcalcule, tot_vol_passe, tot_vol_siphon,
tot_vol_ecluse, na.rm =TRUE),
vol_bar = sum(tot_vol, na.rm = TRUE),
vol_passe = sum(tot_vol_passe, na.rm = TRUE),
vol_ecluse = sum(tot_vol_ecluse, na.rm = TRUE),
vol_siphon = sum(tot_vol_siphon, na.rm = TRUE),
vol_volet_vanne_bar = sum(volet_vanne),
debit_moyen_cran = mean(debit_moyen_cran),
debit_moyen_recalcule = mean(Q, na.rm=TRUE)
) %>%
dplyr::mutate(
debit_moyen_vol_recalc = vol_recalc / (24 * 60 * 60),
debit_moyen_vol_bar = vol_bar / (24 * 60 * 60),
debit_moyen_volet_vanne_bar = vol_volet_vanne_bar / (24 * 60 * 60)
)
)
Qj <- Qj %>%
mutate(across(starts_with("vol"), round)) %>%
mutate(across(starts_with("debit"), ~ round(.x,digits=3))) %>%
arrange(date) %>%
slice(-1)
knitr::kable(Qj)
| date | vol_recalc | vol_bar | vol_passe | vol_ecluse | vol_siphon | vol_volet_vanne_bar | debit_moyen_cran | debit_moyen_recalcule | debit_moyen_vol_recalc | debit_moyen_vol_bar | debit_moyen_volet_vanne_bar |
|---|---|---|---|---|---|---|---|---|---|---|---|
| 2018-01-02 | 15050847 | 15181559 | 0 | 71 | 0 | 724080 | 187.798 | 173.804 | 174.200 | 175.712 | 8.381 |
| 2018-01-03 | 18571832 | 18445715 | 0 | 627 | 0 | 196736 | 221.906 | 216.448 | 214.952 | 213.492 | 2.277 |
| 2018-01-04 | 16661476 | 17027392 | 0 | 0 | 0 | 216384 | 213.000 | 194.190 | 192.841 | 197.076 | 2.504 |
| 2018-01-05 | 15210149 | 15290574 | 0 | 462 | 0 | 285056 | 206.431 | 177.269 | 176.043 | 176.974 | 3.299 |
| 2018-01-06 | 17761908 | 17962306 | 0 | 2722 | 0 | 275520 | 209.813 | 206.984 | 205.578 | 207.897 | 3.189 |
| 2018-01-07 | 17919896 | 18192096 | 0 | 0 | 0 | 664320 | 200.165 | 207.406 | 207.406 | 210.557 | 7.689 |
| 2018-01-08 | 14035618 | 14263072 | 0 | 0 | 0 | 1128384 | 179.404 | 163.585 | 162.449 | 165.082 | 13.060 |
| 2018-01-09 | 13665025 | 14002056 | 0 | 120 | 0 | 2929744 | 162.133 | 146.861 | 158.160 | 162.061 | 33.909 |
Le barrage renvoit des volumes vannes, volet, écluse, passe et
siphons. Les volumes sont recalculés par les fonctions de calcul
debit_total. On a dans l’ordre :
Les recalculs qui sont OK :
debit_moyen_cran Le débit moyen à Cran
Débit_moyen_recalculé = Débit recaculé vannes et volets + volumes :
\[ Q = \sum_{t}(vol/86400)=\sum_t \frac{\sum_{i=1}^5 \beta Q_{va}(t,i)+\sum_{i=1}^5 \beta Q_{vo}(t,i)+V_{s}(t)+V_{p}(t)+V_{e}(t)}{86400} \]
Avec
\(V_s\)= volume siphon
\(V_p\)=volume passe
\(V_e\)=volume écluse
\(\beta\)=600
Debit_moy_vol_recalc : presque identique au précédent, au lieu de la moyenne des débits, on calcule la somme du volume et on ramène à 86400
Débit moyen vol_bar : en partant des totaliseurs de volume au barrage, qui sont pourris, on calcule un débit journalier.
Débit moyen vanne_bar : Somme des totaliseurs de volumes volets et vannes sur le barrage, qui sont ramenés à des débits. C’est de là que le problème vient.
Qj %>% select(date| starts_with("debit")) %>%
pivot_longer(cols=starts_with("debit"),names_to = "source",values_to = "Q") %>%
ggplot() + geom_point(aes(x=date,y=Q, col=source)) +
geom_line(aes(x=date,y=Q, col=source))
Il s’agit juste de tester les fonctions ggplotly utilisées plus tard dans le shiny.
niveaux <- debit_barrage %>% select(horodate, niveauvilaineb,
niveaumerb) %>%
rename(horodate = horodate) %>% # todo get rid of horodate in code
pivot_longer(
cols = c("niveauvilaineb", "niveaumerb"),
names_to = "source",
names_prefix = "niveau",
values_to = "niveau"
)
debits_vannes <-
Q12345 %>% select(horodate, starts_with("Qvanne")) %>%
pivot_longer(
cols = starts_with("Qvanne"),
names_to = "vanne",
names_prefix = "qvanne",
values_to = "Q"
)
debits_volets <-
Q12345 %>% select(horodate, starts_with("Qvolet")) %>%
pivot_longer(
cols = starts_with("Qvolet"),
names_to = "volet",
names_prefix = "Qvolet",
values_to = "Q"
)
g1 <- ggplot()+ geom_line(aes(x=horodate, y=niveau, col=source), data=niveaux)
g2 <- ggplot()+ geom_line(aes(x=horodate, y=Q, col=vanne), data=debits_vannes)+
geom_line(aes(x=horodate, y=Q, col=volet), data=debits_volets)
plotly::ggplotly(g1)
plotly::ggplotly(g2)
niveaux%>% plotly::plot_ly(
x= ~horodate,
y= ~niveau) %>%
plotly:: add_lines( color = ~source, colors = "Set1") %>%
plotly:: add_markers( color = ~source, colors = "Set1")
Le crosstalk ne marche pas sur les gros jeux de données => éviter dans le shiny
library(crosstalk)
niveaux <- debit_barrage %>% select(horodate, niveauvilaineb,
niveaumerb) %>%
rename(horodate = horodate) %>% # todo get rid of horodate in code
pivot_longer(
cols = c("niveauvilaineb", "niveaumerb"),
names_to = "source",
names_prefix = "niveau",
values_to = "valeur"
)
niveaux <- debit_barrage %>% select(horodate, niveauvilaineb,
niveaumerb) %>%
rename(horodate = horodate) %>% # todo get rid of horodate in code
pivot_longer(
cols = c("niveauvilaineb", "niveaumerb"),
names_to = "source",
names_prefix = "niveau",
values_to = "niveau"
)
debits_vannes <-
Q12345 %>% select(horodate, starts_with("Qvanne")) %>%
pivot_longer(
cols = starts_with("Qvanne"),
names_to = "vanne",
names_prefix = "qvanne",
values_to = "Q"
)
debits_volets <-
Q12345 %>% select(horodate, starts_with("Qvolet")) %>%
pivot_longer(
cols = starts_with("Qvolet"),
names_to = "volet",
names_prefix = "Qvolet",
values_to = "Q"
)
total <- dplyr::inner_join(niveaux, dplyr::inner_join(debits_vannes, debits_volets))
shared_total <- SharedData$new(total)
g1 <- ggplot()+ geom_point(aes(x=horodate, y=niveau, col=source), data=shared_total)
g2 <- ggplot()+ geom_point(aes(x=horodate, y=Q, col=vanne), data=shared_total)+
geom_point(aes(x=horodate, y=Q, col=volet), data=shared_total)
bscols(
plotly::ggplotly(g1),
plotly::ggplotly(g2))
C’est ce qui est utilisé dans le SIVA actuel.
#install.packages("rAmCharts")
library("rAmCharts")
#> Full amcharts.js API available using amChartsAPI()
#> Look at rAmCharts::runExamples() & https://datastorm-open.github.io/introduction_ramcharts/
#> Bug report or feed back on https://github.com/datastorm-open/rAmCharts
debit_barrage %>%
amTimeSeries(
'horodate',
c("niveaumerb", "niveauvilaineb"),
bullet = c("round", "square"),
color = col <-
c("orange", "limegreen"),
#"yellow","#39CCCC")
backgroundColor = "#40555E",
backgroundAlpha = 0.4,
bulletSize = c(6, 4),
aggregation = "Average",
fillAlphas = c(0.1, 0.1),
groupToPeriods = c('10mm', '30mm', 'hh', 'DD', 'MM', 'MAX'),
# c('hh', 'DD', '10DD','MM','MAX'),
linewidth = c(0.2, 0.2),
legend = TRUE,
# maxSeries = 200,
categoryAxesSettings.minPeriod = "30mm"
) %>%
setExport(enabled = TRUE)
#> Warning in controlgroupToPeriods(groupToPeriods, difft): NAs introduits lors de
#> la conversion automatique
Ici on a un exemple, il suffit de passer les tag pour
utiliser la fonction.
if (!exists("mainpass")) mainpass <- getPass::getPass(msg = "main password")
if (!exists("hostmysql")) {
hostmysql. <- getPass::getPass(msg = "Saisir host")
# ci dessous pour ne pas redemander au prochain tour
hostmysql <- encrypt_string(string = hostmysql., key = mainpass)
} else {
hostmysql. <- decrypt_string(string = hostmysql, key = mainpass)
}
if (!exists("pwdmysql")) {
pwdmysql. <- getPass::getPass(msg = "Saisir password")
pwdmysql <- encrypt_string(string = pwdmysql., key = mainpass)
} else {
# pass should be loaded
pwdmysql. <- decrypt_string(string = pwdmysql, key = mainpass)
}
if (!exists("umysql")) {
umysql. <- getPass::getPass(msg = "Saisir user")
umysql <- encrypt_string(string = umysql., key = mainpass)
} else {
umysql. <- decrypt_string(string = umysql, key = mainpass)
}
# attention il faut avaoir définit mainpass <- "xxxxx"
pool <- pool::dbPool(
drv = RMariaDB::MariaDB(),
dbname = "archive_IAV",
host = hostmysql.,
username = umysql.,
password = pwdmysql.,
port=3306
)
niveaux2 <-
load_niveaux(
debut = as.POSIXct(strptime("2021-01-01 00:00:00",
format = "%Y-%m-%d %H:%M:%S")),
fin = as.POSIXct(strptime("2021-01-10 00:00:00",
format = "%Y-%m-%d %H:%M:%S")),
tags = c(2507, 2508, 2100, 1000,
1100,1300,1400,1902,2000),
con = pool
)
#> Table vilaine_barrage(b_barrage_niveau:2507), chargement de 1291 lignes
#> Table mer_barrage(b_barrage_niveau:2508), chargement de 1291 lignes
#> Table redon_ecluse(b_redonecluse_niveau:2100), chargement de 1290 lignes
#> Table aucfer(b_aucfer_niveau:1000), chargement de 1290 lignes
#> Table molac(b_molac_niveau:1100), chargement de 1290 lignes
#> Table legueslin(b_legueslin_niveau:1300), chargement de 1290 lignes
#> Table sixtsuraff(b_sixtsuraff_niveau:1400), chargement de 1290 lignes
#> Table pontdecran(b_pont_de_cran_niveau:1902), chargement de 1239 lignes
#> Table guerouet(b_guenrouet_niveau:2000), chargement de 275 lignes
#> fin des calculs
poolClose(pool)
#install.packages("rAmCharts")
library("rAmCharts")
niveaux2 %>%
rAmCharts::amTimeSeries(
'horodate',
c("vilaine_barrage",
"mer_barrage",
"redon_ecluse",
"aucfer",
"molac",
"legueslin",
"sixtsuraff",
"pontdecran",
"guerouet"
),
bullet = "round",
color = randomcoloR::distinctColorPalette(9),
#backgroundColor = "#40555E",
#backgroundAlpha = 0.4,
bulletSize = 4,
aggregation = "Average",
fillAlphas = 0.1,
groupToPeriods = c('10mm', '30mm', 'hh', 'DD', 'MM', 'MAX'),
# c('hh', 'DD', '10DD','MM','MAX'),
linewidth = 0.2,
legend = TRUE,
# maxSeries = 200,
categoryAxesSettings.minPeriod = "30mm"
) %>%
setExport(enabled = TRUE)
#> Warning in controlgroupToPeriods(groupToPeriods, difft): NAs introduits lors de
#> la conversion automatique